home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / UTILITY1 / MSWSRC35.ZIP / PAREN.CPP < prev    next >
C/C++ Source or Header  |  1993-10-11  |  9KB  |  312 lines
  1. /*
  2.  *      paren.c            logo parenthesizing module        dko
  3.  *
  4.  *    Copyright (C) 1991 The Regents of the University of California
  5.  *    This Software may be copied and distributed for educational,
  6.  *    research, and not for profit purposes provided that this
  7.  *    copyright and statement are included in all such copies.
  8.  *
  9.  */
  10.  
  11. #include "logo.h"
  12. #include "globals.h"
  13.  
  14. #define assign(to, from)    to = reref(to, from)
  15.  
  16. NODE *the_generation;
  17. typedef NODE *(*nodeinout)(NODE *arg);
  18.  
  19. /* Set the line pointer for a tree.
  20.  */ 
  21. void make_line(NODE *tree, NODE *line) {
  22. /*    setobject(tree, line);    BH */
  23.     setobject(tree, NIL);
  24.     tree->n_obj = line;
  25.     settype(tree, LINE);
  26. }
  27.  
  28. void untreeify(NODE *node) {
  29.     settreepair__tree(node, NIL);
  30.     settype(node, CONS);
  31. }
  32.  
  33. void untreeify_line(NODE *line) {
  34.     if (line != NIL && is_list(line)) {
  35.     untreeify_line(car(line));
  36.     untreeify_line(cdr(line));
  37.     untreeify(line);
  38.     }
  39. }
  40.  
  41. void untreeify_proc(NODE *procname) {
  42.  
  43.     NODE *body = bodylist__procnode(procnode__caseobj(procname));
  44.     NODE *body_ptr;
  45.  
  46.     for (body_ptr = body; body_ptr != NIL; body_ptr = cdr(body_ptr)) {
  47.     untreeify_line(car(body_ptr));
  48.     }
  49.     untreeify(body);
  50. }
  51.  
  52. /* Treeify a body by appending the trees of the lines.
  53.  */ 
  54. void make_tree_from_body(NODE *body) {
  55.  
  56.     NODE *body_ptr, *end_ptr = NIL, *tree = NIL;
  57.  
  58.     if (body == NIL ||
  59.     (is_tree(body) && generation__tree(body) == the_generation))
  60.         return;
  61.     for (body_ptr = body; body_ptr != NIL; body_ptr = cdr(body_ptr)) {
  62.     tree = car(body_ptr);
  63.     assign(this_line, tree);
  64.     make_tree(tree);
  65.     if (is_tree(tree)) {
  66.         tree = tree__tree(tree);
  67.         make_line(tree, car(body_ptr));
  68.         if (end_ptr == NIL)
  69.         settree__tree(body, tree);
  70.         else
  71.         setcdr(end_ptr, tree);
  72.         if (generation__tree(car(body_ptr)) == UNBOUND)
  73.         setgeneration__tree(body, UNBOUND);
  74.         untreeify(car(body_ptr));
  75.         while (cdr(tree) != NIL)
  76.         tree = cdr(tree);
  77.         end_ptr = tree;
  78.     } else {    /* error while treeifying */
  79.         untreeify(body);
  80.         return;
  81.     }
  82.     }
  83.     settype(body, TREE);
  84. }
  85.  
  86. BOOLEAN tree_dk_how;
  87.  
  88. /* Treeify a list of tokens (runparsed or not).
  89.  */ 
  90. void make_tree(NODE *list) {
  91.  
  92.     NODE *tree = NIL;
  93.     NODE *paren_line(NODE *);
  94.  
  95.     if (list == NIL ||
  96.     (is_tree(list) && generation__tree(list) == the_generation))
  97.         return;
  98.     if (!runparsed(list)) make_runparse(list);
  99.     tree_dk_how = FALSE;
  100.     tree = paren_line(parsed__runparse(list));
  101.     if (tree != NIL && tree != UNBOUND) {
  102.     settype(list, TREE);
  103.     settree__tree(list, tree);
  104.     if (tree_dk_how || stopping_flag==THROWING)
  105.         setgeneration__tree(list, UNBOUND);
  106.     }
  107. }
  108.  
  109.  
  110. /* Fully parenthesize a complete line, i.e. transform it from a flat list
  111.  * to a tree.
  112.  */ 
  113. NODE *paren_line(NODE *line) {
  114.  
  115.     NODE *retval = NIL;
  116. //    NODE *save = line;
  117.     NODE *paren_expr(NODE **expr, BOOLEAN inparen);
  118.     NODE *paren_infix(NODE *left, NODE **rest, int old_pri, BOOLEAN inparen);
  119.  
  120.     if (line == NIL) return line;
  121.     retval = paren_expr(&line, FALSE);
  122.     if (NOT_THROWING && retval != UNBOUND) {
  123.     retval = paren_infix(retval, &line, -1, FALSE); 
  124.     retval = cons(retval, paren_line(line));
  125.     }
  126.     return retval;
  127. }
  128.  
  129. /* Parenthesize an expression.  Set expr to the node after the first full
  130.  * expression.
  131.  */ 
  132. NODE *paren_expr(NODE **expr, BOOLEAN inparen) {
  133.  
  134.     NODE *first = NIL, *tree = NIL, *proc, *retval;
  135. //    NODE *save = *expr;
  136.     NODE **ifnode = (NODE **)NIL;
  137.     NODE *gather_args(NODE *, NODE **, BOOLEAN, NODE **);
  138.     NODE *paren_infix(NODE *, NODE **, int, BOOLEAN);
  139.  
  140.     if (*expr == NIL) {
  141.     if (inparen) err_logo(PAREN_MISMATCH, NIL);
  142.     return *expr;
  143.     }
  144.     first = valref(car(*expr));
  145.     pop(*expr);
  146.     if (nodetype(first) == CASEOBJ && !numberp(first)) {
  147.     if (first == Left_Paren) {
  148.         deref(first);
  149.         tree = paren_expr(expr, TRUE);
  150.         tree = paren_infix(tree, expr, -1, TRUE);
  151.         if (*expr == NIL)
  152.         err_logo(PAREN_MISMATCH, NIL);
  153.         else if (car(*expr) != Right_Paren)
  154.         {
  155.         int parens;
  156.  
  157.         err_logo(TOO_MUCH, NIL);    /* throw the rest away */
  158.         for (parens = 0; *expr; pop(*expr))
  159.             if (car(*expr) == Left_Paren)
  160.             parens++;
  161.             else if (car(*expr) == Right_Paren)
  162.             if (parens-- == 0) break;
  163.         }
  164.         else
  165.         pop(*expr);
  166.         retval = tree;
  167.     } else if (first == Right_Paren) {
  168.         deref(first);
  169.         err_logo(UNEXPECTED_PAREN, NIL);
  170.         if (inparen) push(first, *expr);
  171.         retval = NIL;
  172.     } else if (first == Minus_Sign) {
  173.         deref(first);
  174.         push(Minus_Tight, *expr);
  175.         retval = paren_infix(make_intnode((FIXNUM) 0), expr, -1, inparen);
  176.     } else {    /* it must be a procedure */
  177.         if (procnode__caseobj(first) == UNDEFINED && NOT_THROWING &&
  178.         first != Null_Word)
  179.             silent_load(first, NULL);    /* try ./<first>.lg */
  180.         if (procnode__caseobj(first) == UNDEFINED && NOT_THROWING &&
  181.         first != Null_Word)
  182.             silent_load(first, logolib); /* try <logolib>/<first> */
  183.         proc = procnode__caseobj(first);
  184.         if (proc == UNDEFINED && NOT_THROWING) {
  185.         retval = cons(first, NIL);
  186.         tree_dk_how = TRUE;
  187.         } else {
  188.     /* Kludge follows to turn IF to IFELSE sometimes. */
  189.         if (first == If) {
  190.             ifnode = &first;
  191.         }
  192.         retval = gather_args(proc, expr, inparen, ifnode);
  193.         if (retval != UNBOUND) {
  194.             retval = cons(first, retval);
  195.         }
  196.         }
  197.         deref(first);
  198.     }
  199.     } else if (is_list(first)) {   /* quoted list */
  200.     retval = make_quote(first);
  201.     deref(first);
  202.     } else {
  203.     unref(first);
  204.     return first;
  205.     }
  206.     return retval;
  207. }
  208.  
  209. /* Gather the correct number of arguments to proc into a list.  Set args to
  210.  * immediately after the last arg.
  211.  */ 
  212. NODE *gather_args(NODE *proc, NODE **args, BOOLEAN inparen, NODE **ifnode) {
  213.  
  214.     int min, max;
  215.     NODE *gather_some_args(int, int, NODE **, BOOLEAN, NODE **);
  216.     
  217.     if (nodetype(proc) == CONS) {
  218.     min = (inparen ? getint(minargs__procnode(proc))
  219.                : getint(dfltargs__procnode(proc)));
  220.     max = (inparen ? getint(maxargs__procnode(proc))
  221.                : getint(dfltargs__procnode(proc)));
  222.     } else { /* primitive */
  223.     min = (inparen ? getprimmin(proc) : getprimdflt(proc));
  224.     if (min < 0) {        /* special form */
  225.         return ((nodeinout)*getprimfun(proc))(*args);
  226.     }
  227.     /* Kludge follows to allow EDIT and CO without input without paren */ 
  228.     if (getprimmin(proc) == OK_NO_ARG) min = 0;
  229.     max = (inparen ? getprimmax(proc) : getprimdflt(proc));
  230.     }
  231.     return gather_some_args(min, max, args, inparen, ifnode);
  232. }
  233.  
  234. /* Make a list of the next n expressions, where n is between min and max.
  235.  * Set args to immediately after the last expression.
  236.  */ 
  237. NODE *gather_some_args(int min, int max, NODE **args, BOOLEAN inparen,
  238.                NODE **ifnode)
  239. {
  240. //    int parens;
  241.     NODE *paren_infix(NODE *left, NODE **rest, int old_pri, BOOLEAN inparen);
  242.  
  243.     if (*args == NIL || car(*args) == Right_Paren ||
  244.             (nodetype(car(*args)) == CASEOBJ &&
  245.              nodetype(procnode__caseobj(car(*args))) == INFIX)) {
  246.         if (min > 0) return cons(Not_Enough_Node, NIL);
  247. //    if (*args == NIL || car(*args) == Right_Paren) {
  248. //    if (min > 0) return cons(Not_Enough_Node, NIL);
  249.     } else if (max == 0) {
  250.     if (ifnode != (NODE **)NIL && is_list(car(*args))) {
  251.         /* if -> ifelse kludge */
  252.         NODE *retval;
  253.         err_logo(IF_WARNING, NIL);
  254.         assign(*ifnode, Ifelse);
  255.         retval = paren_expr(args, FALSE);
  256.         retval = paren_infix(retval, args, -1, inparen);
  257.         return cons(retval, gather_some_args(min, max, args,
  258.                          inparen, (NODE **)NIL));
  259.     }
  260.     } else {
  261.         if (max < 0) max = 0;   /* negative max means unlimited */
  262.         if (car(*args) != Right_Paren &&
  263.                 (nodetype(car(*args)) != CASEOBJ ||
  264.                  nodetype(procnode__caseobj(car(*args))) != INFIX)) {
  265.             NODE *retval = paren_expr(args, FALSE);
  266. //    if (max < 0) max = 0;   /* negative max means unlimited */
  267. //    if (car(*args) != Right_Paren) {
  268. //        NODE *retval = paren_expr(args, FALSE);
  269.         retval = paren_infix(retval, args, -1, inparen);
  270.         return cons(retva